00100		SUBROUTINE READIT
00200		COMMON /PCIP/ PCH(27,102),IPT(27,101) /ERRFLG/ERRFLG
00300		COMMON/P/P(1) /PL/PL(1) /COPY/NUMP
00400	
00500		COMMON /Q/ BNW(200),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
00600		1 LN,ITYP,TPALN(4),JED  /NAMES/NA(100),LETRS(27),JNAM(27)
00700	CC	1 LN,ITYP,TPALN(4),JED   /IFI/IFI
00800	CC 7/74 COLGATE  COMMON/TYP/ IS FOR COLTTY ROUT.
00900		COMMON /VV/LIMIT,V(1) /A/ROFF(27),NP(27)
01000		1,RDEV(27),XT(27),OTH(20,16),P1(27),JFM(4),IFM(80)
01100		1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
01200		DIMENSION IV(1),LIST(78),JNP(80),KNP(15)
01300	C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
01400	C   40 LIT CHARS + 30 PARAMS PER INST.
01500	C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
01600		COMMON J,L,CNT(27),BT,MK,DF,DUR(27)
01700		1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
01800		1 ,INP(145),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
01900		COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
02000		1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
02100		1 ZZ,CHN,YY 
02200		1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
02300		1  /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
02400		1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
02500		1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
02600	C  /C/=26
02700		EQUIVALENCE (VX1,VX(1)),(KNP,JNP,INP1,INP(1)),(IPP,ISCA(2))
02800		1 ,(ISS,ISCA(9)),(ITT,ISCA(11))
02900		1 ,(IE,ISCA(5)),(ID,ISCA(3)),(IF,ISCA(6)),(IAA,ISCA(10))
03000		1 ,(VX2,VX(2)),(VX3,VX(3)),(VX4,VX(4)),(IDOT,IDAT(11))
03100		1 ,(V,IV),(LIST,IFM(3)),(IG,ISCA(8))
03200		DATA TINST /25H(' TYPE INST NAME, ETC'/)/,KSLA/'/'/
03300		1,TEDIT/20H(' RETYPE LINE?'/  )/,IEN/'N'/,ITMPO/'TEMPO'/
03400	C   *************** READS INPUT  ***********************
03500	
03600		ERRFLG=0
03700		KIMIT=LIMIT-100
03800	C  FOR WARNING ABOUT BUFFER OVERLOAD (LABEL 1774)
03900		ICHD=0
04000	2308	IF(ITYP)GO TO 2127
04100	23081	TYPE TINST
04200		ACCEPT 77732,JNP
04300		IF(JNP(1).EQ.'	')GO TO 23081
04400	CHECK FOR TAB
04500	77732	FORMAT(80A1)
04600	CC	IF(JED)WRITE(21,77732)INP
04700		IF(JED)CALL COLTTY(JNP,21)
04800		JFM(4)='80A1)'
04900	C  PUTS ON LPT AND TTY
05000		GO TO 1074
05100	CC 6/74 COLGATE2127	JREAD=1
05200	CC 6/74 COLGATE 4400	READ(1,77732,END=2337)JNP
05300	2127	IF(READER(JNP))CALL RUNIT
05400	C  READS A LINE.  IF END OF FILE, JUMPS.
05500	CC  SEE END OF PG.6	IF(SOS)WRITE(JOUT,87732)INP
05600	CC 7/74	IF(SOS)CALL COLTTY(JNP,JOUT,3)
05700	CC 6/74  COLGATE 	GO TO(441,442,443,444,445,446)JREAD
05800	
05900	441	JFM(4)='80A1)'
06000	CC	IF(IFI.GE.0)GO TO 1074
06100		IF(LN.EQ.0)GO TO 1074
06200	CC	REREAD 2114,LN,JNP
06300	C****  READS FILES WITH OR WITHOUT LINE NUMBERS! **** NOT AT STANFORD
06400	CC	IF(JNP(1).EQ.'	')GO TO 2308
06500	CHECK FOR TAB ***** DOESN'T DO WITH SOS FILES ******
06600		JFM(1)=' (I,A'
06700		CALL FMT(JFM,JNP,MLX)
06800		REREAD JFM,LN,J,JNP
06900		GO TO 4127
07000	1074	IF(INP1.EQ.IBLA.OR.INP1.EQ.32347529280)GO TO 2308
07100	C  ABOVE FOR COMMENTS DOESN'T CATCH THIS WITH SOS FILES⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗
07200	C  BIG NUM = '<'
07300		IF(INP1.EQ.'	')GO TO 2308
07400	CHECK FOR TAB
07500		JFM(1)='   (A'
07600		CALL FMT(JFM,JNP,MLX)
07700		REREAD JFM,J,JNP
07800	4127	IF(JED)GO TO 41271
07900		IF(K.EQ.'Y')GO TO 41271
08000	C  K CHECK IS TO PASS AFTER RETYPING
08100		TYPE TEDIT
08200		ACCEPT 77732,K
08300		IF(K.EQ.'Y')GO TO 23081
08400		IF(K.EQ.IG)JED=-1
08500	
08600	
08700	41271	IF(J.EQ.IBLA)GO TO 2308
08800	CHECKS FOR SPACE(IBLA)
08900		LLETRS=MLX
09000	C  LETRS FOR NAME CHANGE FEATURE AT 104
09100		MLX=1
09200		IZ=0
09300		JA=-1
09400		ISUB=4
09500		CALL CLEAN(LEND)
09600	C  CLEANS OUT = AND , AND FINDS LINE LENGTH.
09700		ALL=1.
09800		VX1=0
09900		VX2=0
10000		VX3=0
10100		LK=-1
10200		K=0
10300		JRSTA=0
10400		IOFSET=0
10500	C** IOFSET IS FOR 'CONTINUATION PARAMETERS' - SO INPUT P'S MATCH INST.
10600	C** CAUTION!!!  ANY 'OFFSET' PARAMS THAT ARE REFERRED TO AFTER AN 'END'
10700	C** MUST USE THE PROPER INTERNAL NUMB. OF SCORE, NOT THE INST. PARAM!!!!!
10800		IF(V(I-1).NE.-9900.-BY)GO TO 364
10900		BY=-1.
11000		I=I-1
11100	364	DO 361 JD=1,LEND
11200		N=INP(JD)
11300		IF(N.NE.'R')GO TO 361
11400	C  LOOKS FOR 'RESTART'
11500		DO 3611 M=JD,LEND
11600		KL=INP(M)
11700		IF(KL.EQ.IBLA)GO TO 3631
11800		IF(KL.EQ.ISEMI)GO TO 3631
11900	CCZZZ IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI.OR.KL.EQ.KSLA.OR.KL.EQ.',')GO TO 3631
12000	3611	INP(M)=IBLA
12100	C   CHANGES 'RESTART' TO BLANKS
12200	3631	DO 363 N=1,NINS
12300		IF(J.NE.INST(N))GO TO 363
12400		IQ(N)=-1
12500	C   SETS RESTART FLAG.  THIS INST WILL NOW APPEAR WITH NEW NUM.
12600		JRSTA=J
12700		GO TO 362
12800	363	CONTINUE
12900	361	IF(N.EQ.ISEMI)GO TO 6773
13000	6773	K=K+1
13100		IF(K.GT.NINS)GO TO 36
13200		IF(INST(K).NE.J)GO TO 6773
13300		IF(IQ(K).EQ.-1)GO TO 6773
13400	C   FINDS CORRECT INST NUM.  PASSES RESTARTED INSTS.
13500		LK=K
13600		GO TO 1773
13700	36	IF(J.EQ.'RUN;')GO TO 197
13800		IF(J.NE.'RUN')GO TO 97
13900	197	CALL RUNIT
14000	97	IF(J.EQ.'INSER')GO TO 397
14100		IF(J.EQ.'PRECE')GO TO 397
14200		IF(J.NE.'EDIT')GO TO 297
14300	397	ISUB=6  
14400	297	IF(ISUB.GT.4)GO TO 1773
14500		IF(J.EQ.ITMPO)GO TO 1773
14600		IF(J.EQ.'CONDU')GO TO 1773
14700		IF(J.EQ.'PLAY')GO TO 1773
14800		IF(J.EQ.'SECTI')GO TO 1081
14900	C******************  ABOVE AND BELOW FOR 'SECTIONS'
15000		IF(J.EQ.'END')GO TO 1082
15100		IF(J.EQ.'END S')GO TO 1082
15200		IF(J.EQ.'FINIS')GO TO 1082
15300	362	LK=NINS+1
15400		IF(LK.GT.KZY)CALL ERR(7)
15500		INST(LK)=J
15600		LETRS(LK)=LLETRS
15700	C  SAVE HOW MANY LETTERS IN INST. NAME (FOR 'RUNIT')
15800		IZ=LK
15900		GO TO 1773
16000	
16100	C*********** DOWN TO 8001 FOR 'SECTIONS'
16200	1083	V(I)=-99.
16300		KL=1
16400		GO TO 3083
16500	C  READS 'PLAY SECT. N1,N2'
16600	1081	V(I)=-199.
16700		KL=4
16800	3083	DO 2081 K=KL,72
16900	C******  OR 80 ↑↑↑↑↑↑↑↑↑ ?????
17000		IF(INP(K).EQ.IBLA)GO TO 2081
17100		IV(I+1)=INP(K)
17200		I=I+2
17300	3081	BY=-1.
17400		GO TO 2308
17500	2081	CONTINUE
17600	C   READS SECTION IDENTIFIER, -199. MARKS BEGINNING
17700	C1082	IF(V(I-1).EQ.-9900.-BY)I=I-1
17800	C********* FEB 15,71
17900	1082	V(I)=-299.
18000		I=I+1
18100		GO TO 3081
18200	C   MARKS END OF SECTION
18300	C************************
18400	
18500	8001	FORMAT(A5,5F)
18600	107	FORMAT(I,A5,5F)
18700	4	IF(LK.LE.NINS)GO TO 8773
18800		IF(ALL.GT.0)GO TO 1004
18900		IF(IDALL.GT.0)GO TO 8773
19000		BG(LK)=VX1
19100		IDALL=LK
19200		GO TO 2004
19300	C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
19400	1004	BG(LK)=VX1
19500		IF(LK.EQ.IZ)VX1=0
19600	C   MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0.
19700	C   CHECK EFFECT ON 'MOVE'!
19800	C ******** APR.23, 1971  FIXES BG TIMES IN 'MOVE'?????!!!!!!!
19900	2004	NINS=LK
20000		IF(VX3.NE.0)VX2=10000.+VX3
20100		IF(VX2.EQ.0)VX2=-1
20200		DUR(LK)=VX2
20300		GO TO 900
20400	C******** ABOVE FOR REST ONLY ENTRIES.  FEB 18,71
20500	8773	IF(VX2.EQ.0)GO TO 900
20600	C 2 NUMBS HERE MEAN START ON NOTE NUM.VX2 OF INST.VX1
20700		IF(VX1.EQ.0)VX1=LK
20800	C VX1=0 MEANS USE NUMB. OF THIS INST.
20900		VX1=VX1*10000.+VX2
21000	900	IF(VX1.NE.BY)GO TO 497
21100		IF(J.NE.'PLAY')GO TO 5773
21200	C*********** 'PLAY' IS FOR 'SECTIONS'
21300	497	BY=VX1
21400	C  BY=CURRENT BG TIME.
21500		V(I)=-9900.-BY
21600		I=I+1
21700		IF(NWZ.NE.0)CALL BGSORT(BY)
21800	5773	IF(JRSTA.EQ.0)GO TO 3173
21900		DO 173 K=NINS-1,1,-1
22000	173	IF(JRSTA.EQ.INST(K))GO TO 1173
22100	1173	VX1=K
22200		GO TO 7720
22300	C GO DO A 'DUPL'
22400	2173	JRSTA=0
22500	3173	IF(J.EQ.ITMPO)GO TO 1106
22600		IF(J.EQ.'CONDU')GO TO 3018
22700		IF(J.EQ.'PLAY')GO TO 1083
22800	C*********** ABOVE FOR 'SECTIONS'
22900	
23000	
23100	4773	NW=LPAR
23200	CZZZZZZZ	MLX=ML
23300		ML=MLX
23400		IF(I.LT.KIMIT)GO TO 774
23500		TYPE 107,I
23600		IF(I.GE.LIMIT)TYPE 1774
23700	1774	FORMAT(/' ******* TOO MUCH INPUT DATA!!   USE "MIXSCR" *******'/)
23800	774	ALL=1.
23900		DF=0
24000		ISUB=1
24100	CXXX	IF(MLX.LT.LEND)GO TO 17732
24200	CXXX THIS LOST ON );Px . . . ;  TAKEN OUT 8/20/76
24300	CXXX	GO TO 7773
24400	
24500	CZZZZZZZZZZZZZZZZZZZZZZZZ
24600	1299	IF(MLX.LE.LEND)GO TO 1773
24700	CZZZZZZZZZZZZZZZ .LT. ZZZZZZZZZZZZ
24800	
24900	
25000	7773	IF(READER(JNP))CALL RUNIT
25100	C  READS A LINE.  IF END OF FILE, JUMPS.
25200	CQQQ	IF(INP1.EQ.IBLA)GO TO 7773
25300		IF(INP1.EQ.IBLA.OR.INP1.EQ.32347529280)GO TO 7773
25400	C  ABOVE FOR COMMENTS.  BIG NUM = '<'
25500		IF(JED)GO TO 77733
25600		TYPE TEDIT
25700		ACCEPT 77732,K
25800		IF(K.NE.'Y')GO TO 442
25900		TYPE TPALN
26000		ACCEPT 77732,JNP
26100	442	IF(K.EQ.IG)JED=-1
26200	C   DOESN'T WORK FOR EDITS AND INSERTS YET???
26300	
26400	
26500	77733	MLX=1
26600	C  FOR CONTINUATION LINES.(CAN'T 'CONTINUE' TWICE IN A ROW!!)
26700	C   'LISTS' MUST END WITH ; IN NEW(7/74) VERSION. 
26800		CALL CLEAN(LEND)
26900	1773	IF(IPRN.EQ.0)GO TO 17732
27000		L=I-1
27100		IF(QTS.GE.0)GO TO 597
27200		IF(V(I-1).EQ.999.)L=L-1
27300	597	IPRN=IPRN-1
27400		IF(PARENS.EQ.0)GO TO 17733
27500		PARENS=0
27600		LIST(LCNT+2)=L
27700		LCNT=LCNT+3
27800		IF(IPRN.EQ.0)GO TO 17732
27900		IPRN=0
28000	17733	LIST(MOT)=L
28100		MOT=0
28200	C   FOR ERROR TRAP
28300	
28400	CC17732	JZ=0
28500	17732	N=0
28600	17731	ML=MLX
28700	
28800	C   BIG LOOP -- TO END OF PAGE 1.
28900		JPP=-1
29000	C FOR OLD 'DF' STUFF.  CHECKS FOR A Pn
29100		JD=ML
29200	975	N=INP(JD)
29300		IF(N.EQ.IBLA)GO TO 236
29400		IF(N.EQ.IPP)JPP=0
29500	C FOUND  'P'
29600	CCZZZ	IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 236
29700	C ((((())))) MAY 13,71 /Z (D4/E/X 2 3)/ CS/ ETC.  CAN USE 26 LABELS.
29800	33611	IF(N.EQ.'(')GO TO 697
29900		IF(N.NE.')')GO TO 2361
30000	697	INP(JD)=IBLA
30100		L=JD-1
30200	5113	IF(INP(L).NE.IBLA)GO TO 2113
30300		L=L-1
30400		GO TO 5113
30500	2113	IF(N.EQ.')')GO TO 3361
30600		IF(PARENS.EQ.0)GO TO 1140
30700		LCNT=LCNT+3
30800		IF(MOT.NE.0)CALL ERR(3)
30900		MOT=LCNT-1
31000	1140	DO 11401 JC=1,LCNT-1,3
31100		IF(INP(L).NE.LIST(JC))GO TO 11401
31200	C  FINDS DUPLICATE IDENTIFIER
31300		TYPE 11402,INP(L)
31400	CC	CALL EXIT
31500	
31600	11402	FORMAT(' ****** MOTIVIC (',A1,') USED TWICE')
31700	11401	CONTINUE
31800		LIST(LCNT)=INP(L)
31900		PARENS=-1.
32000		INP(L)=IBLA
32100		LIST(LCNT+1)=I
32200		GO TO 236
32300	C ''''''' FOR SINGLE QUOTES
32400	3361	IPRN=IPRN+1
32500		GO TO 236
32600	C  JUMPS BACK INTO QUOTE SECTION
32700	CQ	IF(PARENS.EQ.0)GO TO 2140
32800	CQ	LIST(LCNT+2)=L
32900	CQ	LCNT=LCNT+3
33000	CQ	PARENS=0
33100	CQ	GO TO 33612
33200	CQ2140	LIST(MOT)=L
33300	CQ	GO TO 33612
33400	CQC )))))))))))  LAST ) CAN'T APPEAR AT END OF LINE!!
33500	C @@@@@@@@@@@@ /@Z/DS3/ ETC. 
33600	2361	IF(N.NE.':')GO TO 2362
33700		ICHD=ICHD+1
33800		N=KSLA
33900		GO TO 336
34000	
34100	2362	IF(N.NE.'@')GO TO 5361
34200		DO 113 L=1,LEND
34300		K=JD+L
34400	C   K IS USED AT 240!!!
34500		JG=INP(K)
34600		IF(JG.NE.'-')GO TO 6113
34700		IF(CODE.EQ.-88.)CALL ERR(8)
34800		RETRO=0
34900		INP(K)=IBLA
35000		GO TO 113
35100	6113	IF(JG.NE.'$')GO TO 7113
35200	C  '$' IS FOR INVERSIONS IN 'NOTES'
35300		IF(CODE.EQ.-88.)CALL ERR(8)
35400		INVRT=0
35500		GO TO 113
35600	7113	IF(JG.NE.IBLA)GO TO 4113
35700	113	CONTINUE
35800	4113	DO 6361 JMOT=1,LCNT,3
35900		IF(JG.NE.LIST(JMOT))GO TO 6361
36000		VX1=0
36100		DO 40 M=JD+2,LEND
36200		JG=INP(M)
36300		IF(JG.EQ.IBLA)GO TO 40
36400	CCZZZ	IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.'*')GO TO 140
36500		IF(JG.EQ.KSLA)GO TO 140
36600		IF(JG.EQ.ISEMI)GO TO 140
36700		ML=M
36800		GO TO 240
36900	40	CONTINUE
37000	240	JC=JA
37100		JA=-1
37200		INP(K)=IBLA
37300		CALL SCANR
37400		JA=JC
37500	140	JC=1
37600		KN=LIST(JMOT+1)
37700		M=LIST(JMOT+2)+1
37800		IF(RETRO)GO TO 640
37900		JC=M-1
38000		M=KN-1
38100		KN=JC
38200		JC=-1
38300		RETRO=-1.
38400	640	IF(INVRT)GO TO 940
38500	C INVERSIONS NEXT
38600	840	X=V(KN)
38700		IF(X.GT.-9999.)GO TO 841
38800	C CAN'T INVERT A 'P' NUMBER.
38900		Z=X
39000		GO TO 941
39100	841	RB=X
39200		X=ABS(X)+VX1
39300		Z=X
39400		IF(RB)Z=-Z
39500	941	V(I)=Z
39600	CC	V(I)=X+VX1
39700	C  FINDS CENTER FOR INVERSION (+TRANSP.)
39800		I=I+1
39900		IZ=IZ+1
40000	C IZ USED FOR INTERNAL TEMPO FEATURE (FIXED 6/78)
40100		KN=KN+JC
40200		IF(V(KN-JC).NE.199.)GO TO 940
40300	C 199. IS NOW NUM. FOR 'R' (REST)  7/78
40400		V(I-1)=199.
40500		GO TO 840
40600	
40700	940	Z=V(KN)
40800		IF(Z.LT.-9999.)GO TO 540
40900	C CAN'T INVERT OR TRANSPOSE 'P' NUMBERS.
41000		IF(INVRT.EQ.0)GO TO 440
41100		IF(VX1.EQ.0)GO TO 540
41200	C " @Q N "  WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.(NO LIT)
41300		IF(CODE.EQ.-88.)CALL ERR(8)
41400		IF(CODE.EQ.-33.)GO TO 440
41500		V(I)=Z*VX1
41600		GO TO 7361
41700	440	IF(Z.EQ.199.)GO TO 540
41800	C 199. IS NOW NUM. FOR 'R' (REST)  7/78
41900		Y=0
42000		RB=VX1
42100		IF(Z)RB=-RB
42200		IF(INVRT)GO TO 541
42300		RB=-RB
42400		RC=X
42500	C X IS SET FURTHER BACK.
42600		IF(Z)RC=-RC
42700	C THIS STUFF FOR CHORD FEATURE
42800		Y=(RC-Z)*2
42900	541	Z=Z+RB+Y
43000		Y=ABS(Z)
43100		IF(Y.LT.1.OR.Y.GT.108)CALL ERR(8)
43200	C ERROR IF TRANSP. HAS PUSHED A NOTE NUMBER TOO HIGH OR TOO LOW.
43300		V(I)=Z
43400	CC	IF(INVRT.EQ.0)Y=(X-Z)*2.
43500	CC	V(I)=Z+VX1+Y
43600		GO TO 7361
43700	540	V(I)=Z
43800	7361	IF(JC.GT.0)GO TO 543
43900		IF(CODE.NE.-33)GO TO 543
44000		JG=I
44100		IF(V(I).GT.0)GO TO 543
44200	542	Y=V(JG)
44300		V(JG)=V(JG-1)
44400		V(JG-1)=Y
44500	C THIS STUFF FOR CHORD FEATURE
44600		IF(V(JG-2).GT.0)GO TO 543
44700		JG=JG-1
44800		GO TO 542
44900	543	I=I+1
45000		IZ=IZ+1
45100	C IZ USED FOR INTERNAL TEMPO FEATURE (FIXED 6/78)
45200		KN=KN+JC
45300		IF(KN.NE.M)GO TO 940
45400	
45500		INVRT=-1
45600		RB=V(I-1)
45700		DO 8361 L=JD,LEND
45800		JG=INP(L)
45900	C   PUT IN NOV 25, 72
46000	CCZZZ	IF(JG.EQ.ISEMI)GO TO 93612
46100		KN=L
46200		INP(L)=IBLA
46300		IF(JG.EQ.KSLA)GO TO 9361
46400		IF(JG.EQ.')')IPRN=IPRN+1
46500		IF(JG.NE.ISEMI)GO TO 8361
46600		IAMP=-1
46700		GO TO 9361
46800	8361	CONTINUE
46900	C  ABOVE 4 LINES PUT IN 8/76. REPLACE C***********  ↓↓
47000	
47100	9361	MLX=L+1
47200		IF(L.GE.LEND)GO TO 93612
47300	C************9361	MLX=L
47400	C************	IF(L.EQ.LEND)GO TO 93612
47500	C ↑↑↑↑↑↑↑ 6/75
47600	C  FIX THIS & =IBLA BY CHNGING DO LOOP TO 'GO TO' AT 6721,2722
47700		IF(IAMP.NE.0)GO TO 797
47800		IF(QTS)GO TO 1773
47900	C  GO BACK IF NOT END OF LINE
48000	797	JZ=-1
48100	93612	IF(IAMP.EQ.0)GO TO 93611
48200	C   NOV 25, 72
48300	C*** JUNE 78 *** BELOW GOES TO CHECK ON INTERNAL TEMPO *****IF(QTS)GO TO 3013
48400		IF(QTS)GO TO 9004
48500		GO TO 2722
48600	C  THESE ARE FOR "LIT" ITEMS
48700	C  *******  DO NOT USE '@-' OR '@$' WITH 'LIT', RLIST OR RNOT****
48800	C  NO $ WITH FUNC.  $ WITH NUMS AND RHY CAN GIVE NEG RESULT -- TRY IT!
48900	CCZZZ93611	IF(JG.EQ.ISEMI)GO TO 7773
49000	93611	IF(KN.EQ.LEND)GO TO 7773
49100		JZ=0
49200		IF(IPRN.NE.0)GO TO 1773
49300	C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION.  22/6/73
49400		GO TO 236
49500	C  LAST TIME FOR QUOTES
49600	
49700	C********↑↑ ↑↑ WAS TO 6017  JUNE 10,71
49800	C   JUMPS TO END STRING OF QUOTES
49900	6361	CONTINUE
50000		CALL ERR(0)
50100	C @@@@@@@@@@@@@@@@@@@@@@@@@@
50200	5361	IF(N.EQ.'$')CALL ERR(8)
50300	C  FOUND $  BUT NO @!
50400		INPX=INP(JD+1)
50500		IF(N.NE.ID)GO TO 53611
50600		IF(ISUB.NE.1)GO TO 53611
50700		IF(INPX.NE.IF)GO TO 236
50800	C  JUMP IF NOT DUTY FACTOR
50900		IF(JPP)GO TO 236
51000	C JUMP IF 'P' HAS NOT BEEN SEEN.
51100		DF=DF-100.
51200		GO TO 43615
51300	53611	IF(N.NE.ISS)GO TO 53612
51400		IF(INPX.NE.'U')GO TO 53612
51500		DF=DF-200
51600	C  FOR SUBROUTINE FLAG.  CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
51700		GO TO 43615
51800	53612	IF(N.NE.'M')GO TO 612
51900		IF(INPX.NE.'I')GO TO 612
52000		DF=DF-200.5
52100	C  THE '.5' CALLS 'MICRO' RATHER THAN 'SUBR'.
52200		GO TO 43615
52300	612	IF(N.NE.IAA)GO TO 43611
52400	C   FINDS 'ALL'.
52500		IF(INPX.NE.'L')GO TO 236
52600		ALL=-1.
52700		GO TO 43615
52800	C  TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.
52900	
53000	C  QUAD CALL MUST BE IN 1ST OF 5 PARAMS.  QUAD MUST BE FOLLOWED
53100	C   BY SPC, / OR ;.  OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
53200	C   APPEAR BEFORE  / OR ;, BUT "ALL" MUST! APPEAR 
53300	C   BEFORE! QUAD (IF USED).
53400	C  ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
53500	C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
53600	C  QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
53700	43611	IF(N.NE.'Q')GO TO 4361
53800		IF(INPX.NE.'U')GO TO 4361
53900		QX=-13.
54000		DO 43612 N=JD,LEND
54100		J=INP(N)
54200		IF(J.EQ.IXX)QX=QX-1.
54300		IF(J.EQ.IF)QX=QX-2.
54400		IF(J.EQ.IBLA)GO TO 236
54500		IF(J.EQ.KSLA)GO TO 236
54600	CCZZZ	IF(J.EQ.IBLA.OR.J.EQ.KSLA.OR.J.EQ.ISEMI.OR.J.EQ.',')GO TO 236
54700	43612	INP(N)=IBLA
54800	4361	IF(N.NE.'I')GO TO 43613
54900		IF(ISUB.NE.4)GO TO 43613
55000	C  -1= 'NM INV' MAKES INST NAME, P1 AND P2 INVISIBLE (REPLACES SEG, ETC.)
55100	C  -2= 'NM IE' MAKES 'END' OF PRINTOUT INVIS. ( ;PRINT(P1)--ETC.)
55200	C  -3= BOTH BEGINNING AND END ARE INVIS.
55300	C  THIS IS SO PARAMS MAY BE EXTENDED TO 58 ON TO A DUMMY INST.
55400		L=-1
55500	CSS	N=INP(JD+1)
55600	CSS	IF(N.EQ.IE)L=L-1
55700		IF(INPX.EQ.IE)L=L-1
55800		INVIS(LK)=INVIS(LK)+L
55900	43615	DO 43614 L=JD,LEND
56000		N=INP(L)
56100	CC	IF(N.EQ.IBLA.OR.N.EQ.KSLA)GO TO 236
56200		IF(N.EQ.IBLA)GO TO 236
56300		IF(N.EQ.ISEMI)GO TO 236
56400	CCZZZ	IF(N.EQ.IBLA.OR.N.EQ.','.OR.N.EQ.ISEMI.OR.N.EQ.KSLA)GO TO 236
56500	43614	INP(L)=IBLA
56600	CC43613	IF(N.NE.KSLA)GO TO 636
56700	43613	IF(N.NE.KSLA)GO TO 1336
56800	CC	JZ=-1
56900		IF(JD.GE.LEND-1)JZ=0
57000	C  SO IT WILL READ NEXT LINE.
57100	CZZZZZZZZZZZZZZZ	INP(JD)=ISEMI
57200		GO TO 336
57300	CCZZZ436	IF(INP(MLX).NE.IBLA)GO TO 336
57400	CCZZZ	MLX=MLX+1
57500	CCZZZ	GO TO 436
57600	CC636	IF(JD.LT.LEND)GO TO 1336
57700	CC	ICON=0
57800	CC	GO TO 77731
57900	CC	GO TO 7773
58000	C  TO CONTINUE ON NEXT LINE.
58100	CCZZZ636	IF(N.NE.ISEMI)GO TO 936
58200	1336	IF(N.NE.ISEMI)GO TO 936
58300		IAMP=-1
58400	CC	IF(ISUB.NE.1)IAMP=-1
58500	336	MLX=JD+1
58600		IF(ISUB.GE.104)GO TO 104
58700		IF(ISUB.GT.3)GO TO 1899
58800	   	GO TO (101,102,103),ISUB
58900	C             PAR  MOV LIST  OTHERS
59000	CCZZZ936	IF(N.NE.IDOT)GO TO 736
59100	936	IF(N.NE.IDOT)GO TO 136
59200		L=INP(JD+1)
59300		DO 836 KL=1,10
59400	836	IF(L.EQ.IDAT(KL))GO TO 236
59500		IF(CODE.EQ.-22..OR.CODE.EQ.-23.)INP(JD)=1
59600		GO TO 236
59700	C   CHANGES DOTTED RHYTHMS TO '1'S.
59800	CCZZZ736	IF(N.NE.'*')GO TO 136
59900	CCZZZ	IAMP=-1
60000	CCZZZ	INP(JD)=IBLA
60100	CCZZZ	GO TO 336
60200	136	IF(N.NE.IQT)GO TO 236
60300		DO 1361 K=JD+1,LEND
60400		IF(INP(K).NE.IQT)GO TO 1361
60500		JD=K+1
60600		GO TO 975
60700	C   SKIPS MATERIAL IN QUOTES
60800	1361	CONTINUE
60900		CALL ERR(0)
61000	C   OPEN QUOTES
61100	236	JD=JD+1
61200		IF(JD.LE.LEND)GO TO 975
61300		CALL ERR(1)
61400	1899	CALL SCANR
61500	CZZZZZZZ	ML=MLX
61600	CZZZZZZZZZZZZZZZZZZZZZZZZZZ
61700		GO TO(1,2,3,4,5,6),ISUB
     

00100	101	N=INP(ML)
00200		IZ=ML
00300		ML=ML+1
00400		IF(N.EQ.IBLA)GO TO 101
00410		M=1
00500		JA=-1
00600	C AT THIS POINT IT LOOKS FOR P=PARM, E=END, D=DUPL, C=CONTINUATION, R=RUN.
00700		IF(N.EQ.IPP)GO TO 1
00800		IF(N.EQ.IE)GO TO 2308
00900		IF(N.NE.'R')GO TO 1101
01000		N=INP(ML)
01100	C   'RUN' MAY REPLACE 'END' FOR LAST INST.
01200		IF(N.EQ.'U')CALL RUNIT
01300	CC	M=1 
01400		LPAR=1
01500	C TYPE 'RD' (P1) FOR RANDOM DEVIATION, 'RR'(P100) FOR RANDOM RESTS.
01600		IF(N.NE.'R')LPAR=NUMP+1
01700		GO TO 201
01800	1101	IF(N.EQ.ID)GO TO 303 
01900		IF(N.NE.'C')CALL ERR(0)
02000	C NEXT FOR 'CONTINUATION'.  AUTOMATICALLY PUSHES UP PARAM NUMS.
02100		IOFSET=IOFSET+1
02200		LPAR=IOLDPR+IOFSET
02300		TYPE 1201,IOFSET
02400		IF(LPAR.GT.NUMP)CALL ERR(6)
02500	2201	IF(INP(ML).EQ.IBLA)GO TO 3201
02600	C  TO MOVE POINTER AHEAD.  MUST HAVE BLANK AFTER 'C' OR 'CO' OR 'CONT', ETC.
02700		ML=ML+1
02800		GO TO 2201
02900	3201	IZ=ML-1
03000		M=0
03100		GO TO 201
03200	1201	FORMAT(' →→→→→→ REMEMBER →→→→→ PARAMETER OFFSET=',I2)
03300	
03400	1	CALL SCANR
03500		IOLDPR=VX1
03600	C SAVE PARAM NUM. FOR POSSIBLE 'CONTINUATION'.  BEWARE OF >P30!!!!
03700		LPAR=IOLDPR
03800	C*******	IF(LPAR.GT.30)GO TO 201
03900		IF(LPAR.GT.NUMP)GO TO 201
04000		LPAR=LPAR+IOFSET
04100		IF(LPAR.GT.NUMP)CALL ERR(6)
04200	C*******	IF(LPAR.GT.30)CALL ERR(6)
04300	201	IJ=LPAR
04400		IF(IJ.GT.NUMP+2)CALL ERR(6)
04500	C**************	IF(IJ.GT.32)CALL ERR(6)
04600	CATCHES PARAM. OUT OF RANGE.
04700		IF(QX.GE.0)GO TO 5703
04800		IJ=LPAR+4
04900	C  SETS UP PARAM FOR QUAD CALL
05000		V(I)=IJ+LK*10000
05100		V(I+1)=2*ALL
05200	C  TEST "ALL" FEATURE HERE!!!!!!!
05300	C  X=-13(DEGREES),=-14(X,Y),=-15(CIRCLE FUNCTS),=-16(LINE FUNCTS)
05400		V(I+2)=QX
05500		I=I+3
05600		QX=0.
05700	5703	IAMP=0
05800		IF(IJ.LE.NP(LK))GO TO 897
05900		IF(IJ.LE.NUMP)NP(LK)=IJ
06000	C*******	IF(IJ.LT.31)NP(LK)=IJ
06100	CC897	IF(LPAR.EQ.NUMP+2)LPAR=1
06200	897	V(I)=LPAR+LK*10000
06300	C  +1=WDCNT, +2=CODE, +3='NM' CCCCC
06400		IJ=I+1
06500		I=I+4
06600		ITMP=0
06700		CODE=0
06800		NFLG=1
06900		ML=IZ+M
07000	C   RE=REP  R=RHY  L=LIT  M=MOVE  MX=MOVX  N=NOTES  NU=NUM  
07100	C   S--L=SUBL  S--N=SUBN  T=TAP  RT=RTAP  RL=RLIST  RN=RNOTES
07200	C  QU=QUADC  QUX=QUADX 
07300	5702	ML=ML+1
07400	CC	IF(ML.GT.72)GO TO 99
07500		N=INP(ML)
07600		IF(N.EQ.IBLA)GO TO 5702
07700		IF(N.EQ.',')GO TO 5702
07800		NL=INP(ML+1)
07900		JA=-1
08000		ISUB=0
08100		IF(N.EQ.IXX)GO TO 2703
08200		IF(N.EQ.'R')GO TO 6702
08300		IF(N.EQ.IF)GO TO 8702
08400		IF(N.EQ.IPP)GO TO 7006
08500		IF(N.NE.'C')GO TO 4005
08600		IF(NL.EQ.'U')GO TO 7006
08700	C  FOR 'CUTOFF'
08800	4005	JA=0
08900		IF(N.EQ.IEN)GO TO 6005
09000		IF(N.EQ.'M')GO TO 703
09100		IF(N.EQ.'L')GO TO 2720
09200		IF(N.EQ.ISS)GO TO 6703
09300		IF(N.EQ.ITT)GO TO 4018
09400		IF(N.EQ.IQT)GO TO 5720
09500		IF(N.EQ.ISEMI)GO TO 2018
09600	C 7/75	IF(N.EQ.IPP)JA=-1
09700	C  FOR ;P5  P3;
09800	7006	CALL SCANR
09900		IF(ISUB.EQ.8)GO TO 8
10000		I=I+JJ
10100		V(IJ+1)=NNUM+DF
10200		IF(JJ.EQ.1)GO TO 4006
10300	C  IF NNUM IS '-2' THEN NOTES ARE PRINTED
10400		IF(NNUM.NE.-2)GO TO 5006
10500		IX=IJ+3
10600		DO 2006 K=2,JJ,3
10700	2006  CALL RANR(VX,K)
10800	C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
10900	5006	IX=IJ+2
11000		DO 6006 K=1,JJ
11100	6006	V(IX+K)=VX(K)
11200		IF(NL.EQ.'U')GO TO 8006
11300	C  JUMP FOR 'CUTOFF'
11400		IF(MOD(JJ,3).NE.0)CALL ERR(12)
11500		V(IX+JJ-2)=1.
11600	C  ABOVE ENSURES THAT LAST RAND. UNIT REACHES 100% - 5/74 *********
11700		GO TO 3013
11800	CCCC NOW DONE IN 'SCANR' 7/78   4006	IF(JA)VX1=-VX1/100.-9999.
11900	C  CHANGES ;P5 P3; TO ;P5 -9999.03; ***** CHECK OUT ON OTHER MACHINES!
12000	CIRC4006	IF(JA)VX1=VX1/100.+9999.
12100	CIRC  CHANGES ;P5 P3; TO ;P5 9999.03; ***** CHECK OUT ON OTHER MACHINES!
12200	4006	V(I-1)=VX1
12300		GO TO 3013
12400	8006	V(IJ+1)=-19
12500	C  FOR 'CUTOFF N1, N2' -- TO END RAND TIMES TOGETHER.
12600		GO TO 3013
12700	6702	IF(NL.EQ.IE)GO TO 2703
12800	C   JUMP IF "REP"
12900		IF(NL.EQ.ITT)GO TO 4018
13000	C   JUMP IF "RTAP"
13100		CODE=-22
13200		IF(NL.EQ.'L')CODE=-46.0
13300	C   JUMP IF "RLIST" (LIST OF RAND SELECTIONS)
13400		IF(NL.NE.IEN)GO TO 1016
13500	C   JUMP IF NOT "RNOTES"
13600		JA=0
13700	C   FOR SCANR
13800		CODE=-36.
13900		GO TO 1016
14000	6005	CODE=-33
14100		IF(NL.EQ.'A')GO TO 2721
14200	C  NUMS, NOTES, NAMES.
14300		IF(NL.NE.'U')GO TO 1016
14400		CODE=-44.
14500	1610	JA=-1
14600		GO TO 1016
14700	8702	CODE=-35
14800		IF(NL.EQ.'U')GO TO 1016
14900		ML=ML+1
15000		CALL SCANR
15100	7	V(IJ+1)=CODE+DF
15200		V(IJ+2)=1.
15300		IF(VX1.GT.99)CALL ERR(4) 
15400	C TRAPS F NUMS >99.
15500		V(I)=VX1+200.
15600	CC	IF(VX1.GT.15)CALL ERR(4) 
15700	C TRAPS F NUMS >15.
15800	CC	V(I)=VX1+85.
15900		GO TO 7703
16000	C********  MOVE IS NEXT ***********
16100	703	BW=V(IJ-2)
16200		IC=0
16300	CC	DO 7031 K=ML+1,72
16400		DO 7031 K=ML+1,LEND
16500		LP=INP(K)
16600		IF(LP.EQ.KSLA)GO TO 8031
16700	CC	IF(INP(K).EQ.ISEMI)GO TO 8031
16800		IF(LP.EQ.IPP)IC=1
16900	C 'MOVP' P7 MOVP/10 3,4.9 5,5.9;MOVES FROM RAN SEL. OF P3,P4 TO P5,P5.
17000	7031	IF(LP.EQ.IXX)IC=-1
17100	C   IC=-1 IS FOR MOVX, IC=0 FOR MOVE, IC=1 FOR MOVP.
17200	8031	I=I-1
17300		V(I)=0
17400		X=-9900.-BY
17500		IF(BY.EQ.0)X=-9900.-BG(LK)
17600	   	IF(BW.EQ.X)GO TO 8005
17700		IF(BW.NE.-9900.-BY)GO TO 1102
17800		V(IJ-2)=X
17900		GO TO 8005
18000	1102	V(IJ)=V(IJ-1)
18100		V(IJ-1)=X
18200		IJ=IJ+1
18300		I=I+1
18400	8005	LP=IJ-1
18500		BW=-9900.-X
18600		ISUB=2
18700		IZ=-1
18800	C  ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
18900	4703	GO TO 1299
19000	102	IF(IZ.LT.0)GO TO 2102
19100	C  SKIPS NEXT FIRST TIME
19200		BW=V(ICT)+BW
19300		V(I)=-9900.-BW
19400		V(I+1)=V(LP)
19500		V(I+2)=(JJ+2)*ALL
19600		V(I+3)=CODE+DF
19700		I=I+4
19800		IZ=1
19900	2102	IF(BW.LT.10000.)CALL BGSORT(BW)
20000	C   ROUND-OFF NONSENSE
20100	2	VX3=-9900.
20200		VX2=VX3 
20300		CALL SCANR
20400		IF(JJ.GT.0)GO TO 5102
20500		JJ=ILIT
20600	C SLASH WILL REPEAT MOVE INPUT -- 6/74
20700		DO 6102 K=1,JJ
20800	6102	VX(K)=VX(K+20)
20900		GO TO 5005
21000	C::::::::::::::: PUT THIS, AND AT 5505, IN SCOR5 ALSO ::::::::::::::
21100	5102	IF(JJ.EQ.4)CALL ERR(9)
21200	C  ERROR -- 4 ITEMS IN MOVE IMPOSSIBLE
21300		IF(VX3.NE.-9900.)GO TO 3102
21400		IF(VX2.NE.-9900.)GO TO 4102
21500		VX2=VX1
21600		VX1=10000.
21700	4102	VX3=VX2
21800		JJ=3
21900	C  1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
22000	3102	IF(IZ.GE.0)GO TO 3006
22100		V(IJ)=(JJ+2)*ALL
22200	C  WORD COUNT
22300		CODE=-55.
22400		IF(JJ.NE.3)CODE=-57.
22500		IF(NFLG)CODE=CODE-1.
22600		IF(IC)CODE=-59.
22700	C  CODE=-56 OR -58 FOR NOTES.
22800		V(IJ+1)=CODE+DF
22900		IZ=0
23000	3006	IF(NFLG.EQ.1)GO TO 5005
23100		CALL RANR(VX,2)
23200	      IF(JJ.NE.3)CALL RANR(VX,4)
23300	C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
23400	5005	IF(IC.LE.0)GO TO 3003
23500	C NEXT FOR 'MOVP',  MOVE FROM PARAM TO PARAM.
23600		DO 1003 K=2,JJ
23700	1003	VX(K)=-VX(K)/100.0-19999.0
23800	CIRC1003	VX(K)=VX(K)/100.0+9999.0
23900	C  CHANGES PARAM NUMS TO MAGIC NUMS.
24000	3003	ICT=I
24100		ILIT=JJ
24200	C  SAVES FOR SLASH REPEAT FEATURE
24300	  	IJ=IJ+1
24400		DO 1006 K=1,JJ
24500		VX(20+K)=VX(K)
24600	C  SAVES FOR SLASH REPEAT FEATURE
24700	1006	V(IJ+K)=VX(K)
24800		I=I+JJ  
24900		IJ=I+2
25000		IF(IAMP.EQ.0)GO TO 1299
25100	C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
25200		V(I)=-9900.-BY
25300		GO TO 8703
25400	
25500	7703	V(IJ)=4.*ALL
25600	8703	I=I+1
25700		GO TO 4773
25800	C   FOR SUBROUTINES, -12=NUMS.  -11=LETTERS.
25900	6703	CODE=-12.
26000		IF(INP(ML+3).EQ.'L')CODE=-11.
26100		V(IJ)=2.*ALL
26200		V(IJ+1)=CODE+DF
26300		I=I-1
26400		GO TO 4773
26500	4018	CNT(LK)=-9900.-BY
26600		P(LK)=V(I-4)
26700	CC 6/74 COLGATE 	JREAD=3
26800	CC 6/74 COLGATE	GO TO 4400
26900	1444	IF(READER(JNP))CALL RUNIT
27000	C  READS A LINE.  IF END OF FILE, JUMPS.
27100	CC443	IF(IFI)REREAD 107,K,IPT(LK,1)
27200	CC	IF(IFI.GE.0)REREAD 8001,IPT(LK,1)
27300	443	IF(LN.NE.0)REREAD 107,K,IPT(LK,1)
27400		IF(LN.EQ.0)REREAD 8001,IPT(LK,1)
27500	C   NAME OF RHYTHM FILE. (ONLY ONE PER INST.)  READS DATA JUST BEFORE RUN
27600		IF(J.EQ.'CONDU')GO TO 444
27700		IF(NL.NE.ITT)GO TO 2338
27800		CODE=-23.
27900		GO  TO 1016
28000	2338	I=I-4
28100		GO TO 4773
28200	3018	CNT(KZY)=-9900.
28300		LK=KZY
28400	C TO PUT 'CONDUCT' FILE NAME IN LAST SLOT (KZY) AT 443
28500		GO TO 1444
28600	444	P(KZY)=980000.
28700		GO TO 2308
28800	C   CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
28900	C  'REP'
29000	2703	ML=ML+1
29100		VX1=0
29200		VX2=0
29300		VX3=0
29400		IF(N.EQ.IXX)GO TO 2704
29500		INP(ML)=IBLA
29600		INP(ML+1)=IBLA
29700	C  WIPES OUT 'EP' IN 'REP'
29800	2704	CALL SCANR
29900	 	V(IJ)=3.
30000		V(IJ+1)=-66.0
30100		IF(VX1.EQ.32.)VX1=1.
30200		IF(VX1.EQ.0)VX1=LPAR
30300		IF(VX2.EQ.0)VX2=LK-1
30400		V(IJ+2)=VX1+VX2*10000.
30500		KL=VX2
30600		IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
30700		IF(VX3.EQ.0)GO TO 4773
30800		L=VX3
30900		ML=LK+1
31000		DO 1018 KL=ML,L
31100		IF(LPAR.LE.NP(KL))GO TO 997
31200		IF(LPAR.LT.31)NP(KL)=LPAR
31300	997	IF(DUR(KL))DUR(KL)=DUR(LK)
31400	C  TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
31500		V(I)=V(I-4)+10000.
31600		V(I+1)=3.
31700		V(I+2)=-66.
31800		V(I+3)=V(I-1)
31900	1018	I=I+4
32000		GO TO 4773
32100	
32200	2018	IF(DF.EQ.0)GO TO 20181
32300	C NEXT FOR Pn SUBR/ I.E. NOTHING BUT P AND SUB CALL. 7/73
32400		V(IJ+1)=-201.
32500		V(IJ+2)=1.
32600		V(IJ+3)=0
32700		GO TO 7703
32800	20181	V(IJ)=3.
32900		V(IJ+1)=-66.
33000		V(IJ+2)=NW+LK*10000
33100		GO TO 4773
33200	C  READS /P5  .3 "ABC" .7 "XYZ"/
33300	
33400	8 	IF(MOD(JJ,2).NE.0)CALL ERR(12)
33500		IF(LPAR.EQ.2)CALL ERR(13)
33600		V(IJ+1)=-77.+DF
33700	C  DF HAS SUBR CALL INFO
33800		I=I+1
33900		VX(JJ-1)=1
34000	C  FOR RAND. SINGLE LITS.
34100		DO 3722 K=1,JJ,2
34200		V(I)=VX(K)
34300	3722	I=I+1
34400		V(IJ+2)=JJ/2
34500		V(IJ+3)=I
34600		DO 4722 K=2,JJ,2
34700		KN=I
34800		I=I+1
34900		L=VX(K)
35000		DO 6722 KL=L,LEND
35100		IF(INP(KL).EQ.IQT)GO TO 4722
35200		IV(I)=INP(KL)
35300	6722	I=I+1
35400	4722	V(KN)=I-KN-1
35500		V(IJ)=(I-IJ)*ALL
35600		GO TO 4773
35700	2720	QTS=0
35800	2721	ISUB=104
35900		IF(NL.EQ.'A')ISUB=ISUB+1
36000		GO TO 1299
36100	
36200	104	IF(ISUB.EQ.104)GO TO 1041
36300	C NEXT FOR INST NAME CHANGES.  Pn NAMES/N;
36400	C  V LIST= n000n/WDCNT/-89/NUM OF DUPLS/INST NAME/NUM OF LETTERS IN NAME/
36500	C  *********** NO 'ALL' OR 'DUPL' FEATURES WITH NAMES **************
36600		V(IJ)=5
36700		V(IJ+1)=-89
36800		CALL SCANR
36900		V(I-1)=VX1
37000		IV(I)=INST(LK)
37100	CXX	IV(I+1)=2**(1+(7-LETRS)*7)
37200		I=I+2
37300		GO TO 4773
37400	1041	KL=0
37500		CODE=-88.
37600		DO 6721 K=ML,LEND
37700		L=INP(K)
37800		IF(L.EQ.IBLA)GO TO 6721
37900		JC=K+1
38000		IF(L.EQ.IQT)GO TO 7721
38100		IF(L.EQ.KSLA)GO TO 7232
38200		IF(L.EQ.ISEMI)GO TO 7232
38300		IF(L.NE.IF)GO TO 1040
38400		IF(INP(K+1).NE.'I')GO TO 1040
38500		IF(INP(K+2).NE.IEN)GO TO 1040
38600		IF(INP(K+3).NE.IE)GO TO 1040
38700	C FINDS THE WORD "FINE".
38800		V(I)=-10000.
38900		IF(DUR(LK))DUR(LK)=10000
39000		GO TO 1042
39100	1040	IF(L.EQ.'%')INP(K)=KSLA
39200		IF(L.EQ.'?')INP(K)=ISEMI
39300		IF(L.EQ.'!')INP(K)=','
39400		IF(L.EQ.'#')INP(K)='<'
39500		IF(L.EQ.'&')INP(K)='"'
39600	C  THE ABOVE ARE ALL SPECIAL CHAR'S TO AVOID VARIOUS CONFUSIONS.
39700		IF(KL.EQ.0)KL=K
39800	6721	CONTINUE
39900	C  FOR REPEAT OF ITEM BY SLASH
40000	C  KL IS START OF QUOTE, THEN K IS END -- WHEN NO "S ARE USED.
40100	7232	IF(KL.EQ.0)GO TO 7233
40200		JC=KL
40300		ML=K+1
40400		JD=K-1
40500		NLIT=K-KL
40600		GO TO 8721
40700	
40800	7233	DO 7230 KL=ILIT,ILIT+NLIT
40900		V(I)=V(KL)
41000	7230	I=I+1
41100		GO TO 27222
41200	7231	CONTINUE
41300	
41400	5720	IAMP=-1
41500		JC=ML+1
41600	C  FOR SINGLE 'LIT' ITEMS.
41700	7721	DO 1722 KL=JC+1,LEND
41800		IF(INP(KL).NE.IQT)GO TO 1722
41900		JD=KL-1
42000		ML=KL+1
42100		NLIT=KL-JC
42200	C   EXTENT OF LIT ITEM IS FOUND
42300		GO TO 8721
42400	1722	CONTINUE
42500	C  CAN'T USE SLASH FOR REPEAT AFTER @Q
42600	8721	V(I)=NLIT
42700		ILIT=I
42800		DO 9721 K=JC,JD
42900	C   PUTS ITEM IN "IV" ARRAY
43000		I=I+1
43100	9721	IV(I)=INP(K)
43200		I=I+1
43300	27222	IF(IAMP.EQ.0)GO TO 1299
43400	2722	V(I)=999.
43500	1042	QTS=-1.
43600		CODE=-88.
43700	CXCX	X=-88.
43800	CNEW	IF(ISUB.EQ.105)X=-89.
43900	C 105, -89. FOR LIST OF NAMES FOR INST. NAME CHNGS.
44000		IF(LPAR.EQ.2)CALL ERR(13)
44100	C NO 'LIT' WITH P2!!
44200		V(IJ+1)=CODE+DF
44300	CXCX	V(IJ+1)=X+DF
44400		V(IJ)=(I-IJ+1)*ALL
44500		IJ=IJ+2
44600		V(IJ)=IJ+1
44700		I=I+1
44800		ISUB=1
44900		GO TO 1299
45000	
45100	303	IF(INP(ML).NE.IF)GO TO 7720
45200	C NEXT FOR 'DF' DUTY FACTOR IN PLACE OF A Pn.  (TAKE OUT OLD DF STUFF LATER.)
45300	CC	ML=ML+1
45355	C 'M' IS USED AFTER 897 INSTEAD OF 'ML'
45400		LPAR=NUMP+2
45500	C USE P101 FOR DF.
45600		GO TO 201
45700	
45800	7720	V(I)=LK
45900		V(I+1)=3.
46000		V(I+2)=-67.
46100		ML=ML+4
46200		IF(JRSTA.EQ.0)CALL SCANR
46300		IF(VX1.EQ.0)VX1=LK-1
46400	C DUPL 0; = DUPL PREV. INST. NUM
46500	 	V(I+3)=VX1
46600		I=I+4
46700		L=VX1
46800		IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
46900		IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
47000		IF(JRSTA.NE.0)GO TO 2173
47100	C GO BACK IF THIS WAS AN AUTOMATIC 'DUPL' WITH A 'RESTART'
47200		GO TO 4773
47300	C   TYPE 'DUPL N;'   N=INST # TO BE DUPLICATED.
47400	142	FORMAT(I,15A5) 
47500	1301	FORMAT(15A5) 
47600	1302	FORMAT(1X15A5) 
47700	CCC2773	FORMAT(I,A5,72A1) 
47800	CC2114  FORMAT(I,80A1)
47900	300	FORMAT(I,3F,A1)
48000	301	FORMAT(3F,A1)
48100	6	IF(J.NE.'PRECE')GO TO 1341
48200	C  'PRECEDE' WRITES LINES DIRECTLY ON DSK, BEFORE THE WORD 'PLAY;'.
48300	C  NO LIMIT TO THE NUMBER OF LINES.  LAST LINE (NOT PRINTED) MUST 
48400	C  BEGIN WITH *.     KNP ARRAY (15) IS EQUIV. TO INP .
48500	4341	IF(ITYP)GO TO 5341
48600		TYPE TPALN
48700		ACCEPT 1301,KNP
48800		CALL SHORT(KNP,K)
48900		WRITE(21,1301)(KNP(JD),JD=1,K)
49000		GO TO 6341
49100	5341	IF(LN.EQ.0)GO TO 2341
49200	CC5341	IF(IFI.GE.0)GO TO 2341
49300		READ(23,142,END=7341)K,KNP
49400		GO TO 3341
49500	7341	CALL ERR(10)
49600	C   GO TO ERROR ROUTINE IF MISSING "*".
49700	2341	READ(23,1301,END=7341)KNP
49800	3341	CALL SHORT(KNP,K)
49900	C  DON'T TYPE TRAILING BLANKS
50000		IF(MX.EQ.22)GO TO 6341
50100		IF(SOS)TYPE 1302,(KNP(JD),JD=1,K)
50200	6341	IF(MX.EQ.22)WRITE(JOUT,1302)(KNP(JD),JD=1,K)
50300		REREAD 77732,JD
50400	C 77732 READS A1 FORMAT.
50500		IF(JD.EQ.'*')GO TO 2308
50600		IF(MX)WRITE(1,1301)(KNP(JD),JD=1,K)
50700	CC	IF(MX)WRITE(23,1301)KNP
50800		GO TO 4341
50900	1341	KB=KB+1
51000		IF(JED.GT.0)JED=0
51100		IF(J.EQ.'INSER')GO TO 1340
51200		OTH(KB,1)=VX1*100000.+VX2*100.+VX3   
51300		GO TO 340   
51400	1340	X=VX1
51500		IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2    
51600		OTH(KB,1)=X
51700		GO TO 1338
51800	C   ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR
51900	C   INSTRUMENT.  FOR COMMENT AT START, SET BG TIME TO 1,1 
52000	C   - BEGIN LINE WITH  <,END WITH ; 
52100	C   UP TO 75 CHARACTERS MAY BE TYPED.     
52200	340      IF(VX3.NE.2)GO TO 1338 
52300		IF(ITYP.GE.0)GO TO 449
52400	CC	JREAD=5
52500	CC 6/74  COLGATE	GO TO 4400
52600		IF(READER(JNP))CALL RUNIT
52700	C  READS A LINE.  IF END OF FILE, JUMPS.
52800	445	OTH(KB,3)=1.
52900	CC	IF(IFI.GE.0)GO TO 447
53000		IF(LN.EQ.0)GO TO 447
53100		REREAD 300,K,OTH(KB,2)
53200		GO TO 1447
53300	447	REREAD 301,OTH(KB,2)
53400	CIRC447	REREAD 301,OTH(KB,2)
53500	1447	IF(JED)GO TO 2308
53600	3445	TYPE TEDIT
53700		ACCEPT 77732,K
53800		IF(K.EQ.IG)JED=-1
53900		IF(J.EQ.'INSER')GO TO 3446
54000		IF(K.NE.'Y')GO TO 2308
54100		IF(JED)GO TO 2308
54200	449	TYPE TPALN
54300		ACCEPT 301,OTH(KB,2)
54400		IF(JED)WRITE(21,301) OTH(KB,2)
54500		GO TO 2308
54600	
54700	1338	IF(ITYP.GE.0)GO TO 1449
54800	CC	JREAD=6
54900	CC 6/74 COLGATE	GO TO 4400
55000		IF(READER(JNP))CALL RUNIT
55100	C  READS A LINE.  IF END OF FILE, JUMPS.
55200	CC446	IF(IFI.GE.0)GO TO 448
55300	446	IF(LN.EQ.0)GO TO 448
55400		REREAD 142,K,(OTH(KB,JD),JD=2,16)    
55500		GO TO 1446
55600	448	REREAD 1301,(OTH(KB,JD),JD=2,16)    
55700	1446	IF(JED)2446,3445,2446
55800	3446	IF(K.NE.'Y')GO TO 2446
55900		IF(JED)GO TO 2446
56000	1449	TYPE TPALN
56100		ACCEPT 1301,(OTH(KB,JD),JD=2,16)
56200		IF(JED)WRITE(21,1301)(OTH(KB,JD),JD=2,16)
56300	2446	X=OTH(KB,2)
56400		IF(J.NE.'INSER')GO TO 971
56500		IF(VX3.EQ.0)GO TO 971
56600		IF(X.NE.'*')GO TO 6
56700	971	IF(X.EQ.'*')KB=KB-1
56800	C   ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #.
56900	C   LAST LINE HAS '*' IN COLUMN 1.
57000		GO TO 2308
57100	C   IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED.
57200	C   INSERT MAY INCLUDE 10 CHARS(P3-P30),
57300	C   P2, A # ONLY.  IF MORE THAN 1 PARAM IS TO BE EDITED AND
57400	C   P2 IS ONE OF THEM, FIRST EDIT P2 TO DESIRED VALUE,
57500	C   CHANGE P2 TO MINUS = THEN INSERT ENTIRE NOTE TO PLAY
57600	C   JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
57700	C   BX=INST N. Y=NOTE N. Z=PARAM N. 
     

00100	1106	KTMP=1
00200	CC	TP=60.
00300		IAMP=0
00400		BW=BY
00500		ITMP=-1
00600		ISUB=5
00700		JA=-1
00800		GO TO 2016
00900	3019	V(I)=990000.00
01000		V(I+1)=4.
01100		V(I+2)=VX1
01200		V(I+3)=VX2
01300		V(I+4)=VX3
01400	CC	V(I+3)=VX2/TP
01500	CC	V(I+4)=VX3/TP
01600		I=I+5
01700		BY=BW
01800	C  SEPT 18, 70
01900		IF(VX1.EQ.0)GO TO 2308
02000		BW=BW+VX1
02100		V(I)=-9900.-BW
02200		I=I+1
02300		CALL BGSORT(BW)
02400	9003	IF(IAMP)GO TO 4003
02500	2016	VX3=0
02600		VX2=0
02700		GO TO 1299
02800	5	IF(VX2.NE.0)GO TO 105
02900	C  'TEMPO/120;'  OR  'TEMPO/1.5 72;'  IS OK.
03000		VX2=VX1
03100		VX1=0
03200	105	IF(VX2.GE.12.)VX2=VX2/60.
03300	C TEMPO < 12 = A FACTOR, ≥12 = MM. NUM.
03400	   	IF(VX3.GE.12.)VX3=VX3/60.
03500		IF(VX3.EQ.0)VX3=VX2
03600	CC105	IF(VX3.EQ.0)VX3=VX2
03700	CC	IF(VX2.LT.11.)TP=1.
03800		IF(J.EQ.ITMPO)GO TO 3019
03900	  	PCH(1,KTMP)=VX1
04000		PCH(2,KTMP)=VX2
04100		PCH(3,KTMP)=VX3
04200	C   PCH(1)=TIME  (2)=MM1  (3)=MM2
04300		KTMP=KTMP+1
04400		IF(IAMP.EQ.0)GO TO 2016
04500	4003	VX1=0
04600		IAMP=0
04700		VX2=VX3
04800		IF(J.EQ.ITMPO)GO TO 3019
04900		PCH(1,KTMP)=0
05000		PCH(2,KTMP)=VX2
05100		PCH(3,KTMP)=VX2
05200	C   MM CAN BE FROM 11 UP  TEMPO FACTOR FROM 10 DOWN.  
05300	C   UP TO 30 TEMPO CHANGES MAY BE MADE.   
05400	
05500	1016      IA=I    
05600	      IZ=1  
05700	3100	V(I-2)=CODE+DF
05800	      ISUB=3     
05900	5016	IF(IAMP.GE.0)GO TO 1299
06000	117	IF(IZ-2)3013,9004,9004
06100	103	K=INP(ML)
06200		IF(K.EQ.ITT)GO TO 1106
06300		IF(K.EQ.KSLA)GO TO 1014
06400		IF(K.EQ.ISEMI)GO TO 1014
06500	CZZZZZZZZZZZZ  CC  ZZZZZZZZZZZZ
06600	CCC NOW DONE IN 'SCANR'  	IF(K.NE.IPP)GO TO 1010
06700	CCC	IF(JA.GE.0)GO TO 1899
06800	CCC	JA=-2
06900	CCC	GO TO 1011
07000	1010	IF(K.NE.IBLA) GO TO 1899
07100	1011	ML=ML+1
07200		GO TO 103
07300	3	IF(VX1.EQ.-99.)GO TO 4022
07400		IF(CODE.EQ.-22.)GO TO 2017
07500	  	IF(CODE.LT.-23)GO TO 17
07600		IF(IZ/2*2.EQ.IZ)GO TO 17
07700	C    CHECKS PAIRS OF NUMBERS FOR 'RTAP'
07800	2017	IF(VX1.LT.-9999.)GO TO 3017
07900	CZZ2017	IF(VX1.EQ.-10000.)GO TO 17
08000	CIRC2017	IF(VX1.EQ.10000.)GO TO 17
08100	      VX1=4./VX1
08200		IF(JJ.NE.1)GO TO 2014
08300	3017	V(I)=VX1
08400		GO TO 114
08500	
08600	1217	IF(VX1.EQ.-10000.)GO TO 114
08700	CIRC1217	IF(VX1.EQ.10000.)GO TO 114
08800	C    FOR "FINE" IN LIST
08900	      V(I+1)=VX2
09000	      IF(CODE.EQ.-36.)CALL RANR(V,I)
09100	2217	I=I+1
09200	C  SETS UP STRING OF RAND SELECTIONS
09300		GO TO 114
09400	3217	V(I)=V(I-2)
09500		V(I+1)=RB
09600	C  FOR SLASH REPTS OF RAND SELEC UNITS. ("REP" CAN'T BE USED!)
09700		GO TO 2217
09800	C******** PUT IN ERROR TRAP FOR "REP" ETC. ******
09900	
10000	2014	DO 9006 L=2,JJ
10100		IF(VX(L).EQ.0)GO TO 17
10200	9006	VX1=4./VX(L)+VX1
10300		JJ=1
10400	CCC NOW DONE IN 'SCANR'   17	IF(JA.NE.-2)GO TO 1012
10500	CCC	VX1=-9999.0-VX1/100.0
10600	CCC	JA=-1
10700	CCC1012	IF(ICHD.EQ.0)GO TO 4014
10800	17  	IF(ICHD.EQ.0)GO TO 4014
10900		JJ=1
11000	C  SETS UP NEXT NOTE AS CHORD (THIS ONE BECOMES NEG.)
11100		VX1=-VX1
11200	C  FOR CHORD FEATURE
11300		ICHD=0
11400	4014	V(I)=VX1
11500		IF(CODE.EQ.-46.)GO TO 1217
11600		IF(CODE.EQ.-36.)GO TO 1217
11700		IF(CODE.NE.-35)GO TO 972
11800	C****************** 8/78	IF(VX1.GT.15)CALL ERR(4)
11900	C  FINDS F NUM.>15!
12000	C  JUMP IF STRING OF RAND SELECS.
12100	972	IF(JJ.EQ.1)GO TO 114
12200		L=VX(JJ)-1
12300		X=V(I)
12400		NL=I+1
12500		I=L+I
12600		DO 1017 K=NL,I
12700	1017	V(K)=X
12800	C   ADDS UP TOTAL   OF NOTES IN SEQ.
12900		IZ=IZ+L
13000		GO TO 114
13100	1014	IF(CODE.EQ.-46.)GO TO 3217
13200		IF(CODE.EQ.-36.)GO TO 3217
13300		IF(CODE.NE.-33)GO TO 1103
13400		IF(V(I-2).GE.0)GO TO 1103
13500	C NEXT FOR SLASH REPEAT OF CHORD
13600	CCC	I=I-1
13700		JC=1
13800		JD=1
13900		GO TO 2103
14000	1103	V(I)=RB
14100	C   RB SAVES IT FOR SLASH REPEAT
14200	114      RB=V(I)     
14300	      I=I+1 
14400	      IZ=IZ+1     
14500	      GO TO 5016    
14600	4022	JC=VX2+.3
14700		JD=VX3-.5
14800		IF(JJ.EQ.2)JD=1
14900	C********* MAY 19,71   ----MANY LINES ABOVE.
15000	2103	IZ=IZ+JC*JD 
15100	C   JD=HOW MANY TIMES,  JC=HOW MANY NOTES 
15200		IF(CODE.NE.-33)GO TO 3103
15300	8103	N=0
15400		V(IA-1)=0
15500		DO 4103 K=I-1,1,-1
15600		IF(V(K).GE.0)GO TO 7103
15700		IF(V(K).GT.-9999.0)GO TO 4103
15800	C NEG. NUMBS USUALLY ARE CHORD NOTES,   -9999.N IS SECONDARY PARAM.
15900	7103	N=N+1
16000	4103	IF(N.EQ.JC)GO TO 5103
16100	5103	IF(V(K-1).GE.0)GO TO 6103
16200		IF(V(K).EQ.0)GO TO 6103
16300		K=K-1
16400		GO TO 5103
16500	6103	JC=I-K
16600	CC	I=I+1
16700	
16800	3103	DO 1005 K=1,JD    
16900		NL=I+JC-1  
17000		DO 2005 L=I,NL    
17100	2005  V(L)=V(L-JC)
17200	1005      I=I+JC  
17300		RB=V(NL)
17400	C  RB SAVES DATA FOR SLASH REPEAT FEATURE.
17500	      GO TO 5016  
17600	
17700	9004	IF(ITMP.EQ.0)GO TO 3013
17800		IZ=IZ-1
17900	C***** JAN. 1974
18000	      KA=1  
18100	      IC=1  
18200	      K=0   
18300		J=1
18400	      Z=0   
18500	      RC=0  
18600	9007	Y=PCH(3,IC)
18700		X=PCH(2,IC)
18800	CC9007	Y=PCH(3,IC)/TP
18900	CC	X=PCH(2,IC)/TP
19000	      Z=PCH(1,IC) 
19100		CALL SQYY(YY,X,Y,Z)
19200		XT(1)=X
19300	      PR=RA 
19400	C75      RD=1  
19500	C75      RB=0  
19600	      ZZ=Z  
19700	      CALL ACCEL
19800	      IF(K.EQ.IZ)GO TO 3013
19900		IF(RA.NE.-10000.)GO TO 9007     
20000	C********* MAY 13,71  OMITS REPEATED RHY. FEATURE.
20100	3013	X=I-IJ
20200		V(IJ+2)=X-3.
20300		V(IJ)=X*ALL
20400		IF(CODE.NE.-35)GO TO 4773
20500		M=IJ+3
20600	C   SETS NUMBERS FOR FUNCS.
20700		DO 313 K=M,I-1
20800		X=V(K)
20900		IF(X.LT.-9999.)GO TO 313
21000	CATCHES 'FINE'(-10000), F1-F99 ONLY PLEASE. USE  NEG. FOR REST IN FUNC LIST.
21100	CC	IF(X.LE.0)V(K)=85.
21200	CC	IF(X.EQ.85)GO TO 313
21300	C 'R' CAN APPEAR IN FUNC LIST  (BUT NOW YOU CAN'T USE F85!!!)
21400	CC	IF(X.GT.15.)CALL ERR(4)
21500	CC	V(K)=X+85.
21600		V(K)=X+200.
21700		IF(X.LT.0)V(K)=199.
21800	CCC	IF(X.LT.85.)V(K)=X+85.
21900	313	CONTINUE
22000		GO TO 4773
22100	
22200		END